# meta %>%
# filter(su_tract == 1) %>%
# select(varname, about) %>% as.list()
glimpse(esdat)
## Rows: 160
## Columns: 54
## $ census_tract <chr> "51001090100", "51001090100", "51001090…
## $ year <int> 2012, 2013, 2014, 2015, 2016, 2017, 201…
## $ conventional <int> 64, 111, 108, 90, 120, 155, 139, 166, 2…
## $ fha_insured <int> 1, 3, 6, 7, 6, 6, 19, 14, 20, 11, 20, 1…
## $ va_guaranteed <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
## $ usda_guaranteed <int> 0, 0, 0, 2, 1, 0, 0, 1, 6, 4, 9, 13, 8,…
## $ req_preapproval <int> 4, 3, 8, 5, 4, 8, 3, 3, 3, 0, 6, 8, 1, …
## $ noreq_preapproval <int> 30, 43, 30, 11, 30, 19, 164, 191, 255, …
## $ originated_loans <int> 47, 65, 68, 66, 89, 109, 103, 113, 167,…
## $ approvedApp_notAccepted <int> 3, 4, 4, 1, 6, 3, 1, 3, 4, 1, 2, 5, 3, …
## $ app_denied <int> 4, 25, 21, 15, 8, 21, 15, 11, 16, 14, 1…
## $ app_withdrawn <int> 4, 3, 11, 8, 16, 11, 18, 28, 22, 1, 5, …
## $ fileclosed_incomplete <int> 0, 1, 1, 3, 3, 6, 6, 4, 5, 1, 1, 4, 8, …
## $ purchased_loan <int> 10, 21, 12, 18, 18, 19, 24, 35, 44, 16,…
## $ denied_preapproval <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
## $ approve_preapproval <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
## $ appRace_AIAN <int> 0, 0, 0, 3, 0, 0, 0, 0, 1, 0, 0, 0, 2, …
## $ appRace_Asian <int> 0, 0, 1, 1, 1, 0, 0, 0, 4, 0, 1, 0, 1, …
## $ appRace_Black <int> 0, 0, 0, 1, 2, 2, 0, 1, 2, 5, 12, 10, 1…
## $ appRace_HawPI <int> 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, …
## $ appRace_White <int> 53, 93, 101, 88, 110, 137, 146, 153, 19…
## $ appRace_multiracial <int> 0, 0, 0, 0, 0, 1, 0, 0, 3, 0, 0, 0, 4, …
## $ appRace_missing <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
## $ appRace_NA <int> 7, 10, 6, 6, 11, 11, 12, 22, 35, 7, 11,…
## $ appEth_HispLat <int> 0, 1, 4, 1, 0, 4, 2, NA, NA, 0, 0, 1, 1…
## $ appMale <int> 37, 63, 65, 62, 86, 95, 95, 96, 128, 39…
## $ appFemale <int> 20, 33, 41, 36, 28, 50, 50, 61, 80, 20,…
## $ appsex_missing <int> 4, 13, 5, 7, 15, 13, 10, 15, 15, 4, 2, …
## $ highCost_mortgages <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
## $ nonHighCost_mortgages <int> 68, 119, 117, 111, 140, 169, 60, 69, 91…
## $ firstlien_secured <int> 58, 97, 104, 93, 121, 149, 165, 192, 25…
## $ sublien_secured <int> 0, 1, 1, 0, 1, 1, 2, 2, 2, 0, 0, 1, 2, …
## $ median_income_000s <dbl> 130.0, 106.5, 107.0, 110.5, 118.5, 117.…
## $ med_loan_amount_000s <dbl> 164.0, 162.0, 143.0, 170.0, 177.0, 155.…
## $ total_apps <int> 68, 119, 117, 111, 140, 169, 167, 194, …
## $ overall_denial_rate <dbl> 0.05882353, 0.21008403, 0.17948718, 0.1…
## $ perc_white_apps <dbl> 77.94118, 78.15126, 86.32479, 79.27928,…
## $ perc_black_apps <dbl> 0.0000000, 0.0000000, 0.0000000, 0.9009…
## $ perc_hislat_apps <dbl> 0.0000000, 0.8403361, 3.4188034, 0.9009…
## $ white_denial_rate <dbl> 0.05660377, 0.21505376, 0.17821782, 0.1…
## $ black_denial_rate <dbl> NA, NA, NA, 1.0000000, 0.0000000, 0.500…
## $ hislat_denial_rate <dbl> NA, 0.00, 0.25, 0.00, NA, 0.25, 0.00, N…
## $ median_income_accepted_app <dbl> 134.0, 107.0, 114.0, 118.0, 119.0, 119.…
## $ loans_per_units <dbl> 0.011573504, 0.016005910, 0.016744644, …
## $ perc_conventional <dbl> 97.87234, 93.84615, 94.11765, 86.36364,…
## $ perc_govern_backed <dbl> 2.127660, 6.153846, 5.882353, 13.636364…
## $ sum_mortgage_dollars_in000s <int> 9005, 12187, 12468, 11616, 18309, 20637…
## $ perc_app_missingRace <dbl> 11.764706, 13.445378, 7.692308, 10.8108…
## $ tract_population <int> 2941, 2941, 2941, 2941, 2941, 2930, 293…
## $ minority_population <dbl> 6.02, 6.02, 6.02, 6.02, 6.02, 6.62, 6.6…
## $ median_family_income <int> 52600, 51600, 52000, 52700, 52300, 5330…
## $ tract_owner_occupied_units <int> 1323, 1323, 1323, 1323, 1323, 1095, 109…
## $ tract_one_to_four_family_homes <int> 4061, 4061, 4061, 4061, 4061, 4158, 415…
## $ countyfips <chr> "001", "001", "001", "001", "001", "001…
esdat[which(esdat$year == 2020),] %>% select(total_apps, overall_denial_rate, white_denial_rate, black_denial_rate, hislat_denial_rate, perc_conventional, perc_govern_backed) %>%
select(where(~is.numeric(.x))) %>%
as.data.frame() %>%
stargazer(., type = "text", title = "Summary Statistics", digits = 1,
summary.stat = c("mean", "sd", "min", "median", "max"))
##
## Summary Statistics
## ===================================================
## Statistic Mean St. Dev. Min Median Max
## ---------------------------------------------------
## total_apps 121.3 78.7 26 105 258
## overall_denial_rate 0.1 0.04 0.1 0.1 0.2
## white_denial_rate 0.1 0.04 0.04 0.1 0.2
## black_denial_rate 0.3 0.3 0 0.3 1
## hislat_denial_rate 0.1 0.1 0.0 0.0 0.2
## perc_conventional 70.9 11.6 53.8 68.0 88.6
## perc_govern_backed 29.1 11.6 11.4 32.0 46.2
## ---------------------------------------------------
longdat <- esdat[which(esdat$year == 2020),] %>% select(c(census_tract, total_apps, overall_denial_rate, white_denial_rate, black_denial_rate, hislat_denial_rate, perc_conventional, perc_govern_backed)) %>% pivot_longer(-census_tract, names_to = "measure", values_to = "value")
longdat$measure <- factor(longdat$measure,
levels = c("total_apps", "overall_denial_rate", "white_denial_rate", "black_denial_rate", "hislat_denial_rate", "perc_conventional", "perc_govern_backed"))
longdat %>%
ggplot(aes(x = value, fill = measure)) +
scale_fill_viridis(option = "plasma", discrete = TRUE, guide = FALSE) +
geom_histogram() +
facet_wrap(~measure, scales = "free")
meta %>%
filter(varname %in% c("total_apps", "overall_denial_rate", "white_denial_rate", "black_denial_rate", "hislat_denial_rate", "perc_conventional", "perc_govern_backed")) %>%
mutate(label = paste0(varname, ": ", about)) %>%
select(label) %>%
as.list()
$label [1] “white_denial_rate: The tract denial rate for white applicants”
[2] “black_denial_rate: The tract denial rate for black applicants”
[3] “hislat_denial_rate: The tract denial rate for Hispanic or Latino applicants”
[4] “perc_conventional: The percent of approved applications that were conventional”
[5] “perc_govern_backed: The percent of approved applications that were backed by the USDA, VA, or FHA” [6] “total_apps: The total number of applications in the tract”
[7] “overall_denial_rate: The tract denial rate for all applicants”
esdat %>%
group_by(countyfips, year) %>%
summarize(total_apps = sum(total_apps)) %>%
ggplot(aes(x = year, y = total_apps, color = countyfips)) +
geom_line()
esdat %>%
group_by(countyfips, year) %>%
mutate(denial_rate = mean(na.omit(overall_denial_rate))) %>%
summarize(denial_rate = mean(na.omit(overall_denial_rate))) %>%
ggplot(aes(x = year, y = denial_rate, color = countyfips)) +
geom_line()
mapdat2020 <- mapdat[which(mapdat$year == 2020),]
pal <- colorNumeric("plasma", reverse = TRUE, domain = mapdat2020$total_apps)
leaflet() %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(data = mapdat2020,
fillColor = ~pal(mapdat2020$total_apps),
weight = 1,
opacity = 1,
color = "white",
fillOpacity = 0.6,
highlight = highlightOptions(
weight = 2,
fillOpacity = 0.8,
bringToFront = T
),
popup = paste0("GEOID: ", mapdat2020$GEOID, "<br>",
"Number of applications: ", mapdat2020$total_apps)
) %>%
addLegend("bottomright", pal = pal, values = (mapdat2020$total_apps),
title = "Total number of <br>mortgage applications <br> in 2020", opacity = 0.7)
pal <- colorNumeric("plasma", reverse = TRUE, domain = mapdat2020$appRace_White)
leaflet() %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(data = mapdat2020,
fillColor = ~pal(mapdat2020$appRace_White),
weight = 1,
opacity = 1,
color = "white",
fillOpacity = 0.6,
highlight = highlightOptions(
weight = 2,
fillOpacity = 0.8,
bringToFront = T
),
popup = paste0("GEOID: ", mapdat2020$GEOID, "<br>",
"Number of applications: ", mapdat2020$appRace_White)
) %>%
addLegend("bottomright", pal = pal, values = (mapdat2020$appRace_White),
title = "Total 2020 mortgage<br>applications: White", opacity = 0.7)
pal <- colorNumeric("plasma", reverse = TRUE, domain = mapdat2020$appRace_Black)
leaflet() %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(data = mapdat2020,
fillColor = ~pal(mapdat2020$appRace_Black),
weight = 1,
opacity = 1,
color = "white",
fillOpacity = 0.6,
highlight = highlightOptions(
weight = 2,
fillOpacity = 0.8,
bringToFront = T
),
popup = paste0("GEOID: ", mapdat2020$GEOID, "<br>",
"Number of applications: ", mapdat2020$appRace_Black)
) %>%
addLegend("bottomright", pal = pal, values = (mapdat2020$appRace_Black),
title = "Total 2020 mortgage<br>applications: Black", opacity = 0.7)
pal <- colorNumeric("plasma", reverse = TRUE, domain = mapdat2020$appRace_Asian)
leaflet() %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(data = mapdat2020,
fillColor = ~pal(mapdat2020$appRace_Asian),
weight = 1,
opacity = 1,
color = "white",
fillOpacity = 0.6,
highlight = highlightOptions(
weight = 2,
fillOpacity = 0.8,
bringToFront = T
),
popup = paste0("GEOID: ", mapdat2020$GEOID, "<br>",
"Number of applications: ", mapdat2020$appRace_Asian)
) %>%
addLegend("bottomright", pal = pal, values = (mapdat2020$appRace_Asian),
title = "Total 2020 mortgage<br>applications: Asian", opacity = 0.7)
pal <- colorNumeric("plasma", reverse = TRUE, domain = mapdat2020$appEth_HispLat)
leaflet() %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(data = mapdat2020,
fillColor = ~pal(mapdat2020$appEth_HispLat),
weight = 1,
opacity = 1,
color = "white",
fillOpacity = 0.6,
highlight = highlightOptions(
weight = 2,
fillOpacity = 0.8,
bringToFront = T
),
popup = paste0("GEOID: ", mapdat2020$GEOID, "<br>",
"Number of applications: ", mapdat2020$appEth_HispLat)
) %>%
addLegend("bottomright", pal = pal, values = (mapdat2020$appEth_HispLat),
title = "Total 2020 mortgage<br>applications: Hispanic", opacity = 0.7)
Each of the following maps show the average denial rates for the years 2007-2020
mapdat <- mapdat %>%
group_by(GEOID) %>%
mutate(avg_overall_denial_rate = mean(na.omit(overall_denial_rate))) %>%
ungroup()
pal <- colorNumeric("plasma", reverse = TRUE, domain = mapdat$avg_overall_denial_rate)
leaflet() %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(data = mapdat,
fillColor = ~pal(mapdat$avg_overall_denial_rate),
weight = 1,
opacity = 1,
color = "white",
fillOpacity = 0.6,
highlight = highlightOptions(
weight = 2,
fillOpacity = 0.8,
bringToFront = T
),
popup = paste0("GEOID: ", mapdat$GEOID, "<br>",
"Average overall app denial rate from 2007-2020: ", round(mapdat$avg_overall_denial_rate, 2))
) %>%
addLegend("bottomright", pal = pal, values = (mapdat$avg_overall_denial_rate),
title = "Average overall <br>app denial rate <br>from 2007-2020", opacity = 0.7)
mapdat <- mapdat %>%
group_by(GEOID) %>%
mutate(avg_white_denial_rate = mean(na.omit(white_denial_rate))) %>%
ungroup()
pal <- colorNumeric("plasma", reverse = TRUE, domain = mapdat$avg_white_denial_rate)
leaflet() %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(data = mapdat,
fillColor = ~pal(mapdat$avg_white_denial_rate),
weight = 1,
opacity = 1,
color = "white",
fillOpacity = 0.6,
highlight = highlightOptions(
weight = 2,
fillOpacity = 0.8,
bringToFront = T
),
popup = paste0("GEOID: ", mapdat$GEOID, "<br>",
"Average White app denial rate from 2007-2020: ", round(mapdat$avg_white_denial_rate, 2))
) %>%
addLegend("bottomright", pal = pal, values = (mapdat$avg_white_denial_rate),
title = "Average White <br>app denial rate <br>from 2007-2020", opacity = 0.7)
mapdat <- mapdat %>%
group_by(GEOID) %>%
mutate(avg_black_denial_rate = mean(na.omit(black_denial_rate))) %>%
ungroup()
pal <- colorNumeric("plasma", reverse = TRUE, domain = (mapdat$avg_black_denial_rate))
leaflet() %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(data = mapdat,
fillColor = ~pal((mapdat$avg_black_denial_rate)),
weight = 1,
opacity = 1,
color = "white",
fillOpacity = 0.6,
highlight = highlightOptions(
weight = 2,
fillOpacity = 0.8,
bringToFront = T
),
popup = paste0("GEOID: ", mapdat$GEOID, "<br>",
"Average Black app denial rate from 2007-2020: ", round(mapdat$avg_black_denial_rate, 2))
) %>%
addLegend("bottomright", pal = pal, values = (mapdat$avg_black_denial_rate),
title = "Average Black <br>app denial rate <br>from 2007-2020", opacity = 0.7)
mapdat <- mapdat %>%
group_by(GEOID) %>%
mutate(avg_hislat_denial_rate = mean(na.omit(hislat_denial_rate))) %>%
ungroup()
pal <- colorNumeric("plasma", reverse = TRUE, domain = (mapdat$avg_hislat_denial_rate))
leaflet() %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(data = mapdat,
fillColor = ~pal((mapdat$avg_hislat_denial_rate)),
weight = 1,
opacity = 1,
color = "white",
fillOpacity = 0.6,
highlight = highlightOptions(
weight = 2,
fillOpacity = 0.8,
bringToFront = T
),
popup = paste0("GEOID: ", mapdat$GEOID, "<br>",
"Average His/Lat app denial rate from 2007-2020: ", round(mapdat$avg_hislat_denial_rate, 2))
) %>%
addLegend("bottomright", pal = pal, values = (mapdat$avg_hislat_denial_rate),
title = "Average Hispanic/Latino <br>app denial rate <br>from 2007-2020", opacity = 0.7)
Government back mortages are mortgages insured by the USDA, VA, or FHA
mapdat <- mapdat %>%
group_by(GEOID) %>%
mutate(avg_percgovbacked = mean(na.omit(perc_govern_backed))) %>%
ungroup()
pal <- colorNumeric("plasma", reverse = TRUE, domain = mapdat$avg_percgovbacked)
leaflet() %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(data = mapdat,
fillColor = ~pal(mapdat$avg_percgovbacked),
weight = 1,
opacity = 1,
color = "white",
fillOpacity = 0.6,
highlight = highlightOptions(
weight = 2,
fillOpacity = 0.8,
bringToFront = T
),
popup = paste0("GEOID: ", mapdat$GEOID, "<br>",
"Average % of gov-backed mortgages <br> from 2006-2020: ", round(mapdat$avg_percgovbacked, 2))
) %>%
addLegend("bottomright", pal = pal, values = (mapdat$avg_percgovbacked),
title = "Average % of <br>gov-backed mortgages <br>from 2007-2020", opacity = 0.7)
pal <- colorNumeric("plasma", reverse = TRUE, domain = mapdat2020$perc_govern_backed)
leaflet() %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(data = mapdat2020,
fillColor = ~pal(mapdat2020$perc_govern_backed),
weight = 1,
opacity = 1,
color = "white",
fillOpacity = 0.6,
highlight = highlightOptions(
weight = 2,
fillOpacity = 0.8,
bringToFront = T
),
popup = paste0("GEOID: ", mapdat2020$GEOID, "<br>",
"Percent of gov-backed <br>mortages in 2020: ", round(mapdat2020$perc_govern_backed, 2))
) %>%
addLegend("bottomright", pal = pal, values = (mapdat2020$perc_govern_backed),
title = "Percent of <br>gov-backed <br>mortages in 2020", opacity = 0.7)
# animatemapdat <- st_as_sf(mapdat)
#
# animatemapdat$year = as.numeric(animatemapdat$year)
#
# animatemapdat <- animatemapdat %>% filter_at(vars(NAME, geometry, perc_govern_backed),all_vars(!is.na(.)))
# cville1 <-
# ggplot(animatemapdat) +
# geom_sf(aes(fill = perc_govern_backed), color = "black", alpha = .9, na.rm = TRUE) +
# scale_fill_fermenter(palette = "Blues", direction = 1, type = "seq", n.breaks = 7) +
# theme_void() +
# guides(fill = guide_colourbar(title.position="top", title.hjust = 0.5, barwidth = 1)) +
# labs(fill = "Percent of mortgages backed by gov.", title = 'Year:{frame_time}',
# caption = "Percent of approved mortgage apps backed by the USDA, VA, or FHA") +
# transition_time(as.integer(year)) +
# ease_aes('linear')
# animate(cville1, fps = 1, nframes = 13)